perm filename FINGER.SAI[SAI,LES] blob
sn#834850 filedate 1987-02-19 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00015 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 Begin "finger" COMMENT: This is the official version of FINGER.
C00012 00003 Definitions
C00014 00004 Useful Sail macros
C00016 00005 General I/O
C00020 00006 General procedures
C00036 00007 Break tables and initialization
C00039 00008 Beginning of main block, SORT, NETGRAPH
C00041 00009 Job information
C00048 00010 Print information about someone's mail file
C00051 00011 Show people who are not logged in
C00054 00012 Network Finger
C00058 00013 Identify a list of persons
C00067 00014 Show everyone who is running
C00068 00015 Main program
C00069 ENDMK
C⊗;
Begin "finger" COMMENT: This is the official version of FINGER.
?-?-73 LES Original version of FINGER written
21-Nov-78 LES FINGER
06-Jan-83 JJW Added code to lookup user's message file.
29-Mar-83 JJW Check plan and message files even for non-users.
19-Apr-83 JJW Show phantom jobs except for SYS, ACT, and NS.
18-Jun-83 JJW Read in and interpret HOSTS3 host table.
17-Dec-83 JJW FINGER%Stanford.
11-Feb-85 JJW Disabled spy code.
24-Sep-85 JJW Cosmetic changes to output format.
20-Jan-86 JJW Added code for TCP Ethertip terminal locations, not done yet.
28-Mar-86 JJW Finished code for TCP Ethertip terminal locations.
06-Nov-86 JJW Use upper segment host table.
Changes to be made:
(1) Avoid forcing text to uppercase before sending it to a remote host.
Some Unix sites are case-sensitive.
(2) Allow lists of users at different hosts, e.g., foo@score,bar@navajo.
+++ In case anyone is wondering why FINGER runs so slowly, I've analyzed it
+++ and it seems that most of the wasted time is spent in the "matchup"
+++ block in procedure NAMED. A solution would be to be more intelligent
+++ than reading the entire file FACT.TXT when searching for matches. -- JJW
NETWORK FINGER
A FINGER command containing @<site name> will now attempt to finger people at
other Arpanet sites. It does this by connecting to the FINGER socket at the
specified site and passing the rest of whatever you typed (before and after
the "@<site name>" to the host. If that host supports Network Finger, then
you get whatever they return.
For example, "FING TK@AI" tells you about Tom Knight at MIT-AI and "FING @SRI"
tells you about everyone who is running on SRI-KL. At this writing, only the
following sites respond to a network FINGER: all MIT ITS sites (ai, mc, ml,
dm), sri-kl, sri-ka, and office-1. More will be joining shortly.
Normally only one site can be specified in a single FINGER command, but if you
would like to waste some time, say "FING @*" and it will tell you about
everyone out there.
DOMESTIC FINGER
The system command "FING" shows data on all jobs, in order by programmer
initials. The "IDLE" column shows the time, in minutes, since the given job
was last in the RUN queue. If the job is currently in the STOP or NULL
queues, a "." follows.
If there is a digit in the next column, it represents the number of extra
Data Disc channels that belong to this job. If there is an exclamation point,
then this job's terminal is hidden.
Finally, the "Terminal" part shows the location of the owner (the terminal
that last typed something at this job). "detached", of course means just
that. "disowned" means that the terminal that last owned this line has
released it. "TV" means that this is a television (Data Disc) terminal that
is displaying the channel currently. "tv" means that the terminal that owns
this job isn't looking at it.
If terminals other than the owner are viewing this job's main channel, then
they are listed on subsequent lines, with the job field blank.
POINTING THE FINGER
The command "FING <people list>" shows data only on the specified people. For
example, "FING JMC,DAVE,WILL" requests information on programmer JMC and
anyone whose first or last name begins with "DAVE" or "WILL". String matching
uses the following precedence:
1) exact match on programmer initials,
2) exact match on friendly or last names,
3) match on leading characters of friendly or last names.
If a given string matches more than one person at a given level, it reports
"ambiguous" and lists their names.
If only one person is specified and he is not logged in, it normally tells
when he last logged out and when his mail file was last written and shows his
plan file, if any, but this can be suppressed with switches (see below).
FILE LISTS
Arguments in the FINGER command are separated by commas and/or spaces. An
argument of the form "&<file name>" causes that file to be read. Files can
include references to other files, ad nauseum. In files, everything to the
right of a semicolon on a given line is ignored, so that comments can be put
there.
The default file extension is "DIS" and the default PPN is "[P,DOC]". Thus if
you say "FING &H", it will first look for a file in you area called "H". If
that doesn't exist, it will next try "H.DIS" in your area and, if necessary,
"H.DIS[P,DOC]", the latter being the list of hand-eye people which is kept in
[P,DOC] along with other group lists (see SAIL Telephone Directory).
SWITCHES
Normally, for people who are not logged in, FINGER gives the time of last
logout, mail file information, and plan file. These printouts can be
suppressed by using the "-LOGOUT", "-MAIL", or "-PLAN" switches.
If one or more files are referenced (by &filename), logout times, mail file
information, and plan files are normally suppressed. You can force printing
of these things by using the "/LOGOUT", "/MAIL", or "/PLAN" switches.
Switches may be abbreviated to one letter.
DOCUMENTATION
The command "FINGER ?" will cause this description to be printed out.
;
Comment Definitions;
Comment require "files[f,act]" source_file;
define roomfile = """ROOMS[P,DOC]""";
define prgfile = """FACT.TXT[SPL,SYS]""";
require "[]<>" delimiters;
define !=[comment];
define debug=[false]; ! if TRUE then BAIL is in and no safe arrays;
define ftf2=[false]; ! if TRUE then compile for F2 WAITS;
define spy=[false]; ! if TRUE then special spy feature;
IFC debug THENC
define safer=[];
ELSEC
define safer=[safe];
ENDC
IFC ftf2 THENC
define linemax=['17]; ! max. physical line number;
ELSEC
define ddmin=['62]; ! lowest numbered DD line;
define linemax=['157]; ! max. physical line number;
ENDC
define ttymask=['777]; ! mask for TTY number;
define pnmax=[200]; ! max. # of programmers on project list;
define tmpcormax=[16]; ! max. tmpcor file size;
define docfile=["FINGER.LES[UP,DOC]"]; ! location of documentation file;
require 80 string_pdl; ! needed for recursive calls to NAMED;
Comment Useful Sail macros;
define TAB=[(""&'11)],LF=[(""&'12)],VT=[(""&'13)],FF=[(""&'14)],CR=[(""&'15)],
ALT=[(""&'175)],DEL=[(""&'177)],↓=[(CR&LF)],THRU=[step 1 until],
LN=[length], PROC=[simple procedure],TTYUUO=['51000000000],
EXIT=[quick_code calli 1,'12; calli '12 end];
define blanks=[ ];
redefine blanks=["]&cvms(blanks)&cvms(blanks)&cvms(blanks)&cvms(blanks)&["];
define letters=["ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"];
define inline=[input(inch,inlf)]; ! inputs one line, omitting CRLF;
define inform=[input(inch,inff)]; ! inputs to next form feed;
define symbrk=0; ! for generating symbols;
define break_table(table,term,omit,modes)=[
redefine symbrk=symbrk+1,
zzz=[break]&cvs(symbrk);
simple procedure zzz;
setbreak(table←getbreak,term,omit,modes);
require zzz initialization;
];
define break(id,term,omit,modes)= [
integer id;
break_table(id,term,omit,modes);
];
define scnbrk(id,term,omit,modes)= [
redefine qqq=[tableno]&cvs(symbrk);
integer qqq;
define id(s)=[scan(s,]&cvms(qqq)&[,brk)];
break_table(qqq,term,omit,modes);
];
Comment General I/O;
internal integer brk,eof,inlf,inff; ! Input/output globals;
! I/O channel 0 is used by NETWRK code to read the host table so should
not be used by the code here. Channel 1 is defined as INCH for reading
files. (It is hardwired into the disk MTAPE in CHECK_MAIL.) If additional
channels are needed, assign them here statically. Don't use GETCHAN.;
define inch = 1;
! PREP0 initializes break tables and privileges;
proc prep0;
begin "prep0"
setbreak(inlf←getbreak,LF,CR,"INS");
setbreak(inff←getbreak,FF,NULL,"INS");
ifc spy thenc
call('60000000000,"setprv"); ! REA and WRT privs;
elsec
call('40000000000,"setprv"); ! REA priv for mail files;
endc
end "prep0";
require prep0 initialization;
! OOPS prints an error message and exits the program.;
proc oops(string mess);
begin "oops"
print(↓,mess,↓);
call(0,"reset");
exit;
end "oops";
! LOOK does an open and lookup on a text file and delivers the first line,
ignoring the E directory, if any;
string proc look(string file);
begin "look"
string lin;
boolean fl;
open(inch,"dsk",1,9,0,400,brk,eof);
lookup(inch,file,fl);
if fl then begin
release(inch);
return(del)
end;
lin←inline;
if equ(lin[1 to 9],"COMMENT ⊗") then begin "flush directory"
do inform until brk=ff;
return(inline);
end;
return(lin)
end "look";
! LOOKOUT calls LOOK and returns the first line, unless the file was not
found, in which case it exits with an error.;
string proc lookout(string file);
begin "lookout"
string ss;
if ¬equ(ss←look(file),del) then return(ss) else oops(file&" not found"&↓);
end "lookout";
! LEFT(L,S) returns the leftmost L characters of string S, padding with blanks
if it is not long enough.;
string proc left(integer l; string s);
return(if ln(s)<l then s&blanks[1 to l-ln(s)] else s[1 to l]);
! LPRINT(L,S) prints the leftmost L characters of string S, padding with blanks
if it is not long enough.;
proc lprint(integer l; string s);
if ln(s)<l then print(s,blanks[1 to l-ln(s)]) else print(s[1 to l]);
! RPRINT(L,S) prints the rightmost L characters of string S, padding with blanks
if it is not long enough.;
proc rprint(integer l; string s);
if ln(s)<l then print(blanks[1 to l-ln(s)],s) else print(s[∞-l+1 to ∞]);
Comment General procedures;
preload_with "January", "February", "March", "April", "May", "June",
"July", "August", "September", "October", "November", "December";
string safer array month[1:12];
! DATE converts a date in system date format into a string.;
string proc date(integer d);
! ((year-1964)*12+month-1)*31+day-1;
return(cvs(d mod 31+1) & " "
& month[(d←d div 31) mod 12 +1][1 to 3] & " "
& cvs(d div 12 + 1964));
safer integer array buf[1:tmpcormax]; ! tmpcor file buffer;
! TMPCRD reads a TMPCOR file (called from NETGRAPH).;
boolean procedure tmpcrd(integer filejob);
begin "tmpcrd"
safe own integer array addr[0:2];
integer adrloc;
external integer _skip_;
if adrloc=0 then start_code "initialize"
protect_acs 2;
move 2,buf;
subi 2,1;
hrli 2,-tmpcormax; ! 1=[iowd tmpcormax,buf[1]];
movem 2,access(addr[1]);
move 2,addr;
hrli 2,1;
movem 2,adrloc;
end;
addr[0]←filejob;
call(adrloc,"tmpcrd");
return(_skip_);
end "tmpcrd";
! ATTACH_SYSTEM maps the first 128K words of the WAITS monitor as a
pseudo-upper segment. FETCH then reads a word from the system.;
define attach_system = [call('377777000000,"setpr2")];
define fetch(addr)=[memory['400000+addr]];
! The host-table management code below calls ATTHST in NETWRK to map
in the table as an upper segment.;
external integer hstadr; ! Address of host table, 0 if not mapped;
! Host table procedures defined in NETWRK.FAI;
external integer procedure atthst;
external integer procedure dethst;
! ATTACH_HOST_TABLE maps the HOSTS3 host table into the upper segment.;
proc attach_host_table;
begin "attach_host_table"
call(0,"core2"); ! Flush pseudo-upper segment;
atthst; ! Attach host-table segment;
end "attach_host_table";
! DETACH_HOST_TABLE detaches the segment mapped by ATTACH_HOST_TABLE,
and restores the SETPR2 mapping so that FETCH can work again.;
proc detach_host_table;
begin "detach_host_table"
dethst; ! Detach host table segment;
attach_system;
end "detach_host_table";
integer jbtlin,jobmax,jbtsts,prjprg,ptyjob,ptyimp,whoimp,rmtprt,rmtadr;
! GETPN returns the programmer name for a job, left justified.;
integer proc getpn(integer job);
begin "getpn"
integer pno;
return(if (pno←fetch(prjprg+job)land '777777) land '770000 then pno
else pno lsh (if pno land '7700 then 6 else 12));
end "getpn";
! ACTIVE returns TRUE if a job is actiive.;
boolean proc active(integer job);
begin "active"
integer status,pn;
define jna =['40000000000]; ! job # assigned bit in jbsts;
define jlog=['10000000000]; ! job logged in bit in jbsts;
define jseg=[ '1000000000]; ! upper segment bit in jbsts;
return((status←fetch(jbtsts+job)) land jna ∧
(fetch(jbtlin+job)≠-1 ∨ ¬(status land jseg) ∧ (status land jlog ∨
(pn←getpn(job) lsh 18)≠cvsix("SYS") ∧ pn≠cvsix("ACT")
∧ pn≠cvsix("NS"))));
end "active";
! NETLOC prints the host name or terminal location for an IP address and
port number. It returns FALSE if unable to find the host.;
integer proc netloc(integer address,port);
begin "netloc"
external procedure hstnum; ! In NETWRK.FAI[S,NET];
external procedure ttystr; ! In NETWRK.FAI[S,NET];
external integer jobff;
boolean won,pnet;
safer own integer array ttpage[0:511]; ! A page of core for TTYSTR;
proc prinet; ! For convenience;
print("Internet ");
attach_host_table;
start_code
label typeit,tip,done;
setzm won;
setom pnet;
move 0,address;
pushj '17,hstnum; ! Convert number to a name;
jrst done; ! Lose, return failure;
setom won;
move 0,(1); ! First word of name;
trz 0,'377; ! First 4 chars;
came 0,['522232026400]; ! Compare with ASCIZ/TIP-/;
jrst typeit; ! Not a tip, type host name;
move '13,1; ! Save ptr to host name string;
! (Avoid using stack since it complicates getting parameter
addresses in next two lines.);
move 0,address; ! Should be 36.subnet.0.host;
move 1,port; ! Terminal line number;
andi 1,'77; ! Only 6 bits' worth;
dpb 0,['221000000001]; ! Deposit host;
lsh 0,-16;
dpb 0,['321000000001]; ! Deposit subnet;
push '17,jobff;
movei 0,ttpage[0]; ! Address of scratch page;
movem 0,jobff; ! Set it up for TTYSTR;
pushj '17,ttystr; ! Get TTY location string;
skipa 1,'13; ! Not found, type host name instead;
setzm pnet; ! 1 points to TTY location string;
pop '17,jobff; ! Restore JOBFF;
typeit: skipe pnet; ! Unless we have a TTY string,;
pushj '17,prinet; ! Print "Internet ";
ttyuuo 3,(1); ! Outstr the appropriate string;
done: end;
detach_host_table;
return(won);
end "netloc";
! TTYLOC (in NETFNG.FAI) prints the terminal location string for a PTY that
is not an Internet Telnet server.;
external integer procedure ttyloc(integer jobno); ! PTY location;
! Special spy code below is no longer used.;
IFC spy THENC
boolean spyf;
string spys;
define ouch=2;
procedure spyo;
begin "spyo"
string file,ppn,tty,mess,host;
integer acctim,time,myline,ext,rec,first,outptr,i,pn,line;
safer integer array buf[0:255]; ! 2 disk records;
safer integer array infoarray[0:5]; ! for FILEINFO;
safer integer array mesblk[0:1];
if not spyf then return;
spyf ← false;
arrclr(buf);
acctim ← call(0,"acctim");
time ← acctim land '777777;
myline ← -1; start_code ttyuuo 6,myline end; ! getlin uuo;
ppn ← cvxstr(call(0,"getppn"));
tty ← cvxstr(call(0,"getln"));
if myline land ('1000 lsh 18) then begin "impbit"
integer ptl,lr,hostnbr,byten;
ptl ← myline land ttymask;
if (lr←fetch(ptyjob+ptl))=0 then begin "IMP pty"
host ← " via Internet ";
hostnbr←call(fetch(ptyimp+ptl)+rmtadr,"peek");
for byten←11 step 8 until 35 do
begin
if byten≠11 then host ← host & ".";
host ← host & cvs(ldb(point(8,hostnbr,byten)));
end;
end "IMP pty"
else begin "subjob"
integer p,ch,lost,termid;
safer own integer array str[0:9];
termid ← cvsix("TERMID");
start_code ! adapted from NETFNG;
label jlose;
setzm lost;
movei 0,1;
move 1,lr; ! job no. of pty owner;
hrroi 2,'137; ! read one word from his 137;
movei 3,2; ! to our 2;
calli 0,'400050; ! jobrd;
jrst jlose;
jumpe 2,jlose;
tlne 2,'777777;
jrst jlose;
hrli 2,'777766; ! -10 = 1 leader + 9 text words;
movei 3,str[0];
calli 0,'400050;
jrst jlose;
movei 0,'776;
andcam 0,str[9]; ! ensure null;
move 0,str[0];
came 0,termid;
jlose: setom lost;
end;
if lost then host ← host & " via unknown host"
else begin
host ← " via ";
p ← point(7,str[0],35);
while (ch ← ildb(p)) ≠ 0 do host ← host & ch;
end;
end "subjob";
end "impbit"
else host ← "";
setformat(-2,0); ! for cvs;
spys ← spys & ↓ &
date(acctim lsh -18) & " " &
cvs(time div 3600) & ":" & cvs((time div 60) mod 60) &
" [" & ppn[1 to 3] & "," & ppn[4 to 6] & "] on " & tty &
host & ↓ & ↓;
setformat(-3,0); ! for cvs;
open(ouch,"dsk",'17,0,0,400,brk,eof); ! dump mode;
for ext ← 1 thru 999 do begin "find file"
label again;
file ← "ERRX." & cvs(ext) & "[ERR,SYS]";
lookup(ouch,file,eof); ! find existing file;
if eof then ! lookup failed;
if eof land '777777 = 0 then begin "non-ex file"
enter(ouch,file,eof); ! make new file;
if eof then go to again; ! failed;
rename(ouch,file,'677,eof); ! set protection;
if eof then go to again; ! failed;
first ← 0;
done "find file";
end "non-ex file"
else go to again; ! lookup error;
enter(ouch,file,eof); ! enter RA mode;
if eof then go to again; ! failed;
fileinfo(infoarray);
rec ← (-(infoarray[3] ash -18)) lsh -7 + 1; ! last record number;
useti(ouch,rec); useto(ouch,rec);
arryin(ouch,buf[0],128); ! read last record;
useti(ouch,rec); useto(ouch,rec); ! reposition;
for first ← 128 step -1 until 1 do ! find first null word;
if buf[first-1] then done;
done "find file"; ! exit loop;
again: close(ouch); ! try another;
end "find file";
outptr ← point(7,buf[first-1],35); ! IDPB ptr;
while ln(spys) do idpb(lop(spys),outptr);
arryout(ouch,buf[0],(outptr land '777777)-location(buf[0])+1);
release(ouch);
mess ← ↓ & ";;MACLSP error #" & tty[4 to 6] & ↓;
mesblk[1] ← memory[location(mess)]; ! byte ptr to string;
dpb(memory[location(mess)-1],point(12,mesblk[1],17)); ! length;
for i ← 1 thru jobmax do
if (pn ← fetch(prjprg+i) land '777777) = cvsix(" RPG") or
pn = cvsix(" LGD")
then if (line ← fetch(jbtlin+i)) ≠ -1 then begin
mesblk[0] ← line ← line land '777;
call(line,"beep");
call(location(mesblk[0]),"ttymes");
end;
end "spyo";
ENDC
Comment Break tables and initialization;
scnbrk(totab," ",null,"insk");
scnbrk(tosp," ",null,"insk");
scnbrk(flush,<";, ">,null,"xnr");
scnbrk(tosemi,<";">,null,"iks");
scnbrk(tonolet,letters&"0123456789",null,"xr");
scnbrk(toletdig,<letters&"0123456789*">,null,"inr");
scnbrk(toamp,"&",null,"is");
scnbrk(tofile,<".[, &%(-/@ ">,null,"inr");
scnbrk(torb,<"] ">,null,"ins");
scnbrk(tocomma,<",">,null,"is");
scnbrk(tocrlf,lf,null,"ina");
scnbrk(topercent,<"@%(">,null,"is");
scnbrk(todelim,<" , /">,null,"ikr");
safer string array loc[0:linemax+1]; ! locations of terminals;
IFC ¬ftf2 THENC
safer integer array ddchan[ddmin:linemax]; ! main DD channel for line;
safer integer array vdsmap[ddmin:linemax]; ! Video switch map;
ENDC
! Initialization;
attach_system; ! make monitor = second segment;
jbtlin←fetch('236); ! location of line number table;
jobmax←fetch('222); ! highest possible job number;
jbtsts←fetch('210); ! location of job status table;
prjprg←fetch('211); ! location of project-programmer table;
whoimp←fetch('352) lsh -18; ! left half of 352 points to WHOIMP table;
ptyjob←fetch('270)-(linemax+2); ! location of pty superior job table;
rmtprt ← fetch(whoimp);
rmtadr ← rmtprt lsh -18; ! offset of RMTADR in IMP DDB;
rmtprt ← rmtprt land '777777; ! offset of RMTPRT in IMP DDB;
ptyimp←(fetch(whoimp+3) lsh -18)-(linemax+2); ! ptr to PTYIMP-PTYL0;
Comment Lowcore block format, pointed to by left half of 352:
WHOIMP: RMTADR,,RMTPRT
LCLADR,,LCLPRT
STATE,,TTYLIN
PTYIMP,,0
;
Comment Beginning of main block, SORT, NETGRAPH;
begin "main"
safer integer array job,pn[1:jobmax]; ! job #, PN;
safer string array name[1:jobmax]; ! programmer name table;
integer users; ! # of active jobs;
! SORT does a bubble sort by PN on the active jobs.;
procedure sort;
begin "sort"
integer ji,sin;
boolean sorted;
sin←users;
do begin "bubble sort"
sorted←true;
sin←sin-1;
for ji←1 thru sin do
if pn[ji]>pn[ji+1] then begin
pn[ji]↔pn[ji+1];
job[ji]↔job[ji+1];
name[ji]↔name[ji+1];
sorted←false;
end;
end "bubble sort"
until sorted;
end "sort";
! NETGRAPH prints the name of a network graphics site.;
proc netgraph(integer jb,pty);
begin "netgraph"
integer ngi,nps;
if tmpcrd(cvsix("net")+jb) then
for ngi←1 thru tmpcormax do
if (nps←buf[ngi])=0 then done
else if (nps lsh -24)=pty then begin "site name"
string ns;
ns←cvxstr(nps);
print(ns[3 to 6]);
return
end "site name";
print("??");
end "netgraph";
Comment Job information;
! SHOWJOBS outputs job information.;
procedure SHOWJOBS;
begin "showjobs"
safer integer array exchan[1:jobmax]; ! extra channels used by job;
integer pi,pj,ftime,cdate,ctime,jobnam,jobque,oldie,ownbyt,lstesc;
print(" Person Job Jobnam Idle Terminal"&↓);
sort; ! Sort active jobs by PN;
loc[0]←lookout(roomfile); ! Read file of rooms for TTY lines;
for pi←1 thru linemax+1 do loc[pi]←inline;
release(inch);
IFC ¬FTF2 THENC
for pi←0 thru 31 do begin "ddchan"
integer use,priv;
if (use←(priv←call('200+pi,"ddchan")lsh-18)land '77777) then
if use<'10000 then exchan[use]←exchan[use]+1
else if use<'20000 then
ddchan[use-('10000)]←if priv land '400000 then -pi else pi;
! - means hidden;
! main channel for job;
end "ddchan";
for pi←ddmin thru linemax do vdsmap[pi]←call(('200000+pi)lsh 18,"vdsmap");
ENDC
ownbyt←fetch('333)+'400000; ! byte pointer to owning KBD table;
lstesc←ownbyt land '377777; ! location of LSTESC table;
jobnam←fetch('225); ! location of job name table;
jobque←fetch('231); ! location of job queue table;
ftime←fetch('274); ! location of date,,seconds since run;
cdate←call(0,"date") lsh 18;! current date in left half;
ctime←call(0,"timer")%60; ! seconds since midnight;
oldie←0;
for pi←1 thru users do begin "printout"
integer prog,lr,tim,ptl,line;
string ss;
setformat(2,0);
pj←job[pi];
prog←pn[pi];
if oldie=prog then print(blanks[1 to 22])
else begin "new guy"
string ns;
integer ppn;
oldie←prog;
if ln(ns←name[pi]) then lprint(22,ns)
else if (ppn←pn[pi])=cvsix(" 100") then
print("100 not logged in ")
else begin "unknown"
ns←cvxstr(ppn);
print(ns[4 to 6]," UNKNOWN ");
end "unknown";
end "new guy";
print(pj," ",cvxstr(fetch(jobnam+pj))," ");
tim←fetch(ftime+pj); ! time since last run;
lr←((if cdate=(tim land ('777777 lsh 18)) then 0 else 86400) +
ctime -(tim land '777777))div 60;
if lr≤0 then print(" ") else if lr>999 then print("***") else
rprint(3,cvs(lr));
! Print "." if in STOPQ or NULLQ;
print(if '11≠fetch(jobque+pj)≠'10 then " " else ".");
setformat(0,0);
line ← fetch(jbtlin+pj);
print(if exchan[pj] then cvs(exchan[pj])
IFC FALSE THENC
else if line ≠ -1 and
fetch(lstesc+(line land ttymask)) land '200000 then "!"
ENDC
else " "); ! extra channels or hidden;
if line = -1 then print("detached"&↓)
IFC ¬FTF2 THENC
else if line land ('20000 lsh 18) then begin "DD"
integer dd,dc,di,lin;
lin←line land ttymask;
dc←(1 lsh 35) lsh - abs ddchan[lin]; ! map bit for DD;
dd←ldb(ownbyt+lin); ! KBD that owns this line;
print(if dd='16 then "disowned"
else if VDSMAP[dd] land dc then loc[dd][1 to 43]
else "tv"&loc[dd][3 to 43],↓);
for di←ddmin thru linemax do
if dc land vdsmap[di] ∧ di≠dd then begin
lprint(37,if ddchan[lin]<0 then
" *** SPY *** SPY *** SPY ***" else "");
print(loc[di][1 to 43],↓);
end;
end "DD"
ENDC
else if (line land ('4000 lsh 18)) then begin "PTY"
integer sjob,ddb,byten,hostnbr,port;
lprint(8,"PTY"&cvos(ptl←line land ttymask));
! The location information for a PTY is stored in its
superior job, if there is one, else if it's an IMP PTY
we look in the IMP DDB.;
if (lr ← fetch(ptyjob+ptl)) then begin "superior job"
IFC FTF2 THENC
if ¬(0≤lr≤jobmax) then print("Can't find owner")
else
ENDC
if (ttyloc(lr) ≠ 0) then begin
ss←cvxstr(sjob←fetch(jobnam+lr));
print("job ",lr," ",ss);
if (sjob land '777777)=cvsix(" GRF") then begin
print(" from ");
netgraph(lr,ptl);
end;
end;
end "superior job"
else if (ddb ← fetch(ptyimp+ptl)) then begin "imp pty"
hostnbr ← call(ddb+rmtadr,"peek");
port ← call(ddb+rmtprt,"peek");
if not netloc(hostnbr,port) then begin
! Print in A.B.C.D format if not found in table.;
print("Internet [");
for byten ← 11 step 8 until 35 do begin
if byten≠11 then print(".");
print(ldb(point(8,hostnbr,byten)));
end;
print("]");
end;
end "imp pty"
else print("ORPHAN");
print(↓);
end "PTY"
else print(loc[line land ttymask][1 to 43],↓);
end "printout";
end "showjobs";
Comment Print information about someone's mail file;
procedure check_mail(integer pn);
begin "check_mail"
label rel;
string lin,pns,wrs; boolean fl;
integer time;
safe own integer array filedata[0:5],moredata[0:3];
preload_with cvsix("godmod"),'10;
safe own integer array mtape_block[0:2];
mtape_block[2] ← location(moredata[0]);
open(inch,"DSK",1,2,0,400,brk,eof);
pns ← cvxstr(pn);
flush(pns);
lookup(inch,"msg.msg[1,"&pns&"]",fl);
if fl and (fl ≠ '777777000003) then lookup(inch,cvxstr(pn)&".msg[2,2]",fl);
if fl then begin
print(if fl = '777777000003 then " Mail file in use." else " No mail.");
go to rel
end;
fileinfo(filedata);
quick_code
mtape inch,mtape_block[0];
setom fl;
end;
wrs ← if fl then "???" else cvxstr(moredata[3])[4 to 6]; ! pn of last writer;
flush(wrs);
print(↓,
if ¬equ(pns,wrs) ∨ (moredata[2] ≠ cvsix("e") ∧ moredata[2] ≠ cvsix("rcv"))
then " New mail exists from "&wrs
else " No new mail exists",
", last written at ");
setformat(2,0);
print((time←(filedata[2] land '37770000) lsh -12)%60,":");
setformat(-2,0);
print(time mod 60," on ");
setformat(0,0);
print(date((filedata[1] land '700000) lsh -3
lor (filedata[2] land '7777)),".");
rel: release(inch);
end "check_mail";
Comment Show people who are not logged in;
procedure NIX(integer count; integer array npn; string array nname;
boolean nomail,noplan);
begin
safer integer array datime[1:count]; ! time(s) of last logout;
boolean flag;
integer ni;
arrclr(datime,-1); ! set to -1;
open(inch,"dsk",'10,19,0,400,brk,eof);
lookup(inch," 1 1.ufd[1,1]",flag);
! mfd format: [0] <ppn(36)> [1] "UFD",,<hi date (3)><other (15)>
[3] <protect (9)><mode (4)><minutes (11)><lo date (12)>
[4:15] <junk (36)>;
do begin "search"
integer pno,si;
safer own integer array mfd[0:15];
arryin(inch,mfd[0],16); ! read an MFD entry;
pno←mfd[0] land '777777;
for si←1 thru count do if pno=npn[si] then begin "got one"
datime[si]←datime[si] max
(((mfd[1] land '700000) lsh 15) lor
((mfd[2] land '7777) lsh 18) lor
((mfd[2] land '37770000) lsh -12)); ! date,,time;
done;
end;
end "search"
until eof;
release(inch);
for ni←1 thru count do begin "typout"
integer dat; string ns;
lprint(22,nname[ni]);
if (dat←datime[ni])=-1 then print(" -- no file areas")
else if dat=0 then print("a long time ago")
else begin "date"
integer time;
setformat(2,0);
print((time←dat land '3777)%60,":");
setformat(-2,0);
print(time mod 60," on ");
setformat(0,0);
print(date(dat lsh -18),".");
end "date";
if ¬nomail then check_mail(npn[ni]);
if noplan then print(↓) else
if (ns←look(cvxstr(npn[ni])&".pln[2,2]"))=del then
print(" No plan."&↓) else begin "plan"
print(" Plan:"&↓);
do begin print(" ",ns,↓); ns←inline; end
until eof;
print(↓);
end;
! [shouldn't be needed] release(inch);
end "typout";
end "NIX";
Comment Network Finger;
external integer procedure NETFNG(string command,site);
require "NETFNG" load_module; ! all this courtesy of MRC;
forward procedure running; ! needed for Finger%Stanford;
forward recursive procedure named(string lst);
! NETWORK does a network Finger;
procedure network(string before,after);
begin "network"
string host,arg;
! toletdig(after); ! flush everything up to site name;
flush(after); ! flush everything up to site name;
host←todelim(after);
arg ← before & after;
flush(arg);
attach_host_table;
! hosts removed from list below: SUMEX, UTAH, MIT-XX,
"MIT-AI", "PURDUE-TN", "CSNET-PURDUE", "RUTGERS",
"CMU-CS-IUS", "CMU-CS-VLSI", "CMU-CS-ZOG", "CMU-CS-G",
"CMU-CS-CAD", "CMU-CS-K", "CMU-RI-FAS", "CMU-CS-SPICE",
"CMU-CS-GANDALF", "CMU-RI-LEG", "CMU-RI-ISL",
"CMU-CS-SPEECH", "CMU-CS-UNH", "CMU-RI-ARM",
"CMU-RI-ISL2", "CMU-CS-CFS", "CMU-CS-JK", "CMU-CS-PT",
"CMU-CS-H", "SU-SAFE", "SU-ARDVAX",
"SU-SHASTA", "SU-HNV", "SU-NAVAJO", "SU-WHITNEY",
"SU-GLACIER", "SU-STAR", "SU-CARMEL", "SU-SCORE", "SU-AI", ;
if host = "*" then begin "survey"
for host←
"SRI-AI", "SRI-KL", "MIT-MULTICS", "MIT-DMS", "MIT-ML",
"MIT-MC", "USC-ISI", "USC-ISID", "USC-ISIE", "USC-ISIF",
"USC-ISIB", "CIT-20", "PURDUE", "HI-MULTICS", "WHARTON",
"CMU-CS-A", "CMU-CS-B", "CMU-CS-C", "S1-A"
do begin
print(↓&"Site: ",host,↓);
netfng(arg&↓,host);
end;
end "survey"
else if equ(host,"STANFORD") then begin "stanford survey"
! Do the local finger without using the network.;
print("Site: SAIL",↓);
if arg then named(arg) else running;
! Get the list of other hosts from a file.;
if (host←look("FINGER.HST[HST,NET]")) = del then
print(↓ & "Can't find list of Stanford hosts!" & ↓ &
"Please report this via GRIPE FINGER" & ↓)
else while not eof do begin
if host ≠ null and host ≠ ";" then ! ignore blank and comment lines;
begin
print(↓&"Site: ",host,↓);
netfng(arg&↓,host);
end;
host ← inline;
end;
release(inch);
end "stanford survey"
else netfng(arg&↓,host);
detach_host_table;
exit;
end "network";
Comment Identify a list of persons;
recursive procedure named(string lst);
begin "named"
safer string array handle[1:pnmax]; ! names to be found;
integer hi; ! # of people on list;
integer nologout,nomail,noplan; ! -1=suppress, +1=show logout, mail & plan;
string rs;
rs←toamp(lst);
hi←nologout←nomail←noplan←0;
while ln(lst) do begin "read file"
string file,ext,ppn,line;
nologout←nomail←noplan←true; ! suppress logout times & plans;
toletdig(lst); ! remove "&" and leading blanks;
file←tofile(lst); ! file name up to "." or "[";
ext←if brk="." then lop(lst)&tofile(lst) else null;
if brk≠"[" then ppn←null else begin "ppn"
string pj;
ppn←torb(lst); pj←tocomma(ppn); flush(ppn);
ppn←pj&","&(if ln(ppn) then ppn else
cvxstr(call(0,"dskppn"))[4 to 6])&"]";
end "ppn";
if (line←look(file&ext&ppn))=del ∧
(ln(ext) ∨ (line←look(file&".dis"&ppn)) = del) ∧
(ln(ppn) ∨ (line←look(file&".dis[p,doc]")) = del) then
oops(file&ext&ppn&" file not found");
while ¬eof do begin "read"
rs←rs&","&tosemi(line);
line←inline;
end;
release(inch);
if ln(rs)>(4*pnmax) then oops("Too many people");
rs←rs&","&toamp(lst);
end "read file";
lst←topercent(rs); ! check for network finger;
if ln(rs) then network(lst,rs); ! do a network finger;
flush(lst);
do begin "scan list"
integer op;
if (op←lst)="-" ∨ op="/" then begin "switches"
string switch; integer ls;
toletdig(lst); ! remove "-", "/" & leading blanks;
switch←tonolet(lst);
if equ(switch,"LOGOUT"[1 to ls←ln(switch)]) then nologout← op="-" else
if equ(switch,"MAIL"[1 to ls]) then nomail← op="-" else
if equ(switch,"PLAN"[1 to ls]) then noplan← op="-" else
oops("Undefined switch: "&switch);
end "switches"
else begin "string"
if (hi←hi+1)>pnmax then oops("List too long");
handle[hi]←tonolet(lst);
end;
flush(lst);
end
until ln(lst)=0;
if hi=0 then oops("Null list");
begin "search"
safer integer array state[1:hi]; ! 0 = unknown, 2 = substring match,
3 = ambig. substring match, 4 = exact match, 5 = ambig. match,
6 = PN match, 8 = logged in;
safer integer array npn[1:hi]; ! PNs found;
safer string array nname[1:hi]; ! names found;
string line;
integer ji,jj,statlo;
line←lookout(prgfile); ! read file of PN<tab>names;
do begin "matchup"
integer si,stati;
string fpn,friend,last,mh,namestring;
proc namehim(integer ni); begin ! store state, etc.;
if ni=(stati land '16) then begin "ambiguous"
state[si]←ni+1;
npn[si]←0; ! clear PN;
nname[si]←nname[si]&↓&left(4,fpn)&line;
end
else begin "OK"
state[si]←ni;
npn[si]←cvsix(" "&fpn);
nname[si]←left(4,fpn)&line;
end;
statlo←statlo min ni;
end;
fpn←totab(line); friend←tosp(namestring←line);
last←tosp(namestring); ! upper case-ify;
while (last[∞ for 1]=".") ∨ (length(last)=1)
do last←tosp(namestring); ! ignore initials;
statlo←6;
for si←1 thru hi do if (stati←state[si])<6 then begin "try"
if equ(fpn,mh←handle[si]) then namehim(6)
else if equ(mh,last) ∨ equ(mh,friend) then namehim(4)
else if stati≤3 ∧ (equ(mh,last[1 to ln(mh)]) ∨
equ(mh,friend[1 to ln(mh)])) then namehim(2)
else statlo←statlo min stati;
end "try";
end "matchup"
until ln(line←inline)=0 ∨ statlo=6;
release(inch);
ifc spy thenc
for ji←1 thru hi do if npn[ji] = cvsix(" LGD") then spyf ← true;
spyo;
endc
for ji←1 thru hi do if (jj←state[ji])=0 then begin "not found"
string js;
if 2≤ln(js←handle[ji])≤3 then begin "outlaw?"
npn[ji]←cvsix(" "&js); nname[ji]←left(4,js)&"UNKNOWN";
end
else begin
print("""",handle[ji],""" unrecognized"&↓);
state[ji]←8; ! mark it "finished";
end;
end
else if (jj land 1)=1 then begin "ambiguous";
print("""",handle[ji],""" is ambiguous:"&↓,nname[ji],↓);
state[ji]←8; ! we're done with it;
end;
users←0;
for ji←1 thru jobmax do if active(ji) then begin ! get PPN;
integer pno;
pno←getpn(ji);
for jj←1 thru hi do if pno=npn[jj] then begin "hit"
job[users←users+1]←ji; pn[users]←pno;
name[users]←nname[jj]; state[jj]←8;
end;
end;
if users then showjobs; ! output people logged in;
if nologout then ! suppress the rest?;
if users=0 then oops("None logged in.") else exit;
jj←0;
for ji←1 thru hi do if state[ji]≠8 then begin "check state"
integer pno,ci;
label skip;
if ((pno←npn[ji])land '77)=0 then
pno←pno lsh (if pno land '7777 then -6 else -12);
for ci←1 thru jj do if pno=npn[ci] then go to skip;
nname[jj←jj+1]←nname[ji]; ! do if not a duplicate;
npn[jj]←pno;
skip: end;
if jj then begin
print(if users then ↓&"------------ Last logout"&↓ else
" Person Last logout"&↓);
nix(jj,npn,nname,nomail,noplan); ! find last login;
end;
end "search";
end "named";
Comment Show everyone who is running;
procedure RUNNING;
begin "running"
integer ri,rpn;
string line;
users←0;
for ri←1 thru jobmax do if active(ri) then begin "active"
job[users←users+1]←ri;
pn[users]←getpn(ri);
end;
line←lookout(prgfile); ! this file gives pn<tab>full name;
do begin
string pns;
rpn←cvsix(" "&(pns←totab(line))); ! sixbit pn;
for ri ←1 thru users do
if rpn=pn[ri] then begin
name[ri]←left(4,pns)&line;
done;
end;
end
until ln(line←inline)=0;
release(inch);
showjobs; ! print;
end "running";
Comment Main program;
string comm;
ttyup(true); ! upper case input;
backup; flush(<comm←inchwl>); ! rescan the command;
IFC spy THENC spyf←false; spys←comm; ENDC
if "F"≠comm then tosemi(comm) else tonolet(comm);
flush(comm);
print(↓);
if ln(comm)=0 then running else if comm≠"?" then named(comm) else begin "info"
string ls;
ls←lookout(docfile);
do begin print(ls,↓); ls←inline; end until eof;
release(inch);
end "info";
IFC spy THENC spyo; ENDC
exit;
end "main"
end "finger";